www.gusucode.com > 星梦奇缘交友网 1 > 星梦奇缘交友网 1.0源码程序/love/friendlist2.asp

    <!--#include file=conn.asp-->
<!--#include file=config.asp-->
<!--#include file=const.asp-->
<!--#include file=char.asp-->
<%
 '=========================================================
' File: friendlist.asp
' Version:3.0
' Date: 2005-11-6
' Script Written by xmrxw
'=========================================================
' Copyright (C) 2004,2005 Xmrxw.Com All rights reserved.
' Web: http://www.xmrxw.com,http://www.xmzxw.com
' Email: info@mssky.com,super@mssky.com
' QQ：10689579　Msn：zdlmicr@hotmail.com
'=========================================================
dim msg,Userims,list,flag,Listname
if not founduser then
  	errmsg=errmsg+"<br>"+"<li>您没有<a href=login.asp target=_blank>登录</a>。"
	founderr=true
end if
if Cint(GroupSetting(154))=0 then
  	errmsg=errmsg+"<br>"+"<li>您没有查看好友列表的权限，请立即升级等级再<a href=login.asp target=_blank>登录</a>。"
	founderr=true
end if
stats="好友列表"
call nav()
if founderr=true then
	call head_var("","")
	call Mslove_error()
else
	call head_var(membername & "的帐号","mycount.asp")
	list=trim(request("list"))
	if list="" then list=1
	strFileName="friendlist.asp?list="&list&""%>
<table cellpadding=3 cellspacing=1 align=center class=tableborder1>
<tr>
<th width=12% height=25 id=tabletitlelink><a href=mycount.asp>我的帐号</a></th>
<th width=11%  id=tabletitlelink><a href=mymodify.asp>基本资料</a></th>
<th width=11%  id=tabletitlelink><a href=modifypsw.asp>密码修改</a></th>
<th width=11%  id=tabletitlelink><a href=modifyfd.asp>交友资料</a></th>
<th width=11%  id=tabletitlelink><a href=modifyadd.asp>联系资料</a></th>
<th width=11%  id=tabletitlelink><a href=usersms.asp>短信服务</a></th>
<th width=11%  id=tabletitlelink><a href=friendlist.asp>我的好友</a></th>
<th width=11%  id=tabletitlelink><a href=favlist.asp>我的收藏</a></th>
<th width=11%  id=tabletitlelink><a href=userphoto.asp>我的相册</a></th>
</tr>
</table>
<%call tumppages()
	select case request("action")
	case "info"
		call info()
	case "addF"
		call addF()
	case "saveF"
		call saveF()
	case "审核"
		call Allsavectrl()
	case "移动"
		call MoveAllto()
	case "援救"
		call Sendsos()
	case "Sendsosto"
		call Sendsosto()
	case "删除"
		call DelFriend()
	case "清空好友"
		call AllDelFriend()
	case else
		call info()
	end select
	if founderr then call Mslove_error()
end if
call activeonline()
call footer()

sub info()
Friendjoin=0
set rs=server.createobject("adodb.recordset")'检查用户收友数量
sql="select Count(FID) from [Ms_friend] where username='"&trim(membername)&"'"
set rs=conn.execute(sql)
if not (rs.eof and rs.bof) then
Friendjoin=Rs(0)
else
Friendjoin=0
end if
Rs.close:Set Rs=Nothing
call Frienpic()
%>
<br>
<table cellpadding=3 cellspacing=0 align=center class=tableborder1>
  <tr> 
    <td class=tablebody1 width=130>生存空间（<font color="#FF0000"><%=GroupSetting(145)%></font>）人：</td>
    <%dim Persms,Barwidth
	Persms=Round((Friendjoin/Cint(GroupSetting(145)))*100)
	if Persms=0 then
	Barwidth=0
	else
	Barwidth=Persms+3
	end if%>
    <td Width="*" class=tablebody2><img src="Skins/default/bar/bar.gif" width=<%=Barwidth%> height="16" align=absmiddle title=生存空间(<%=GroupSetting(145)%>)人,已占用(<%=Friendjoin%>)></td>
    <td width=120 class=tablebody1>已使用：<font color=red><%=Persms%></font> ％</td>
  </tr>
</table>
<table cellpadding=3 cellspacing=1 align=center class=tableborder1>
  <form action="friendlist.asp" method=post name=inbox>
    <tr> 
      <th valign=middle width="20%" height=26>姓名</td> 
      <th valign=middle width="5%">性别</td> 
      <th valign=middle width="5%">审核</td> 
      <th valign=middle width="23%">邮件</td> 
      <th valign=middle width="23%">主页</td> 
      <th valign=middle width="10%">OICQ</td> 
      <th valign=middle width="8%">发短信</td> 
      <th valign=middle width="5%">操作</td> </tr>
    <%
	set rs=server.createobject("adodb.recordset")
	if list=1 then
	sql="select F.*,U.useremail,U.UserIM,U.Usersex from Ms_Friend F inner join [Ms_user] U on F.Friend=U.username where F.username='"&trim(membername)&"' and Mybest=1 order by F.addtime desc"
	elseif list=2 then
	sql="select F.*,U.useremail,U.UserIM,U.Usersex from Ms_Friend F inner join [Ms_user] U on F.Friend=U.username where F.username='"&trim(membername)&"' and Mylove=1 order by F.addtime desc"
	elseif list=3 then
	sql="select F.*,U.useremail,U.UserIM,U.Usersex from Ms_Friend F inner join [Ms_user] U on F.username=U.username where F.Friend='"&trim(membername)&"' and Mylove=1 order by F.addtime desc"
	elseif list=4 then
	sql="select F.*,U.useremail,U.UserIM,U.Usersex from Ms_Friend F inner join [Ms_user] U on F.username=U.username where F.Friend='"&trim(membername)&"' and Mybest=1 order by F.addtime desc"
	elseif list=5 then
	sql="select F.*,U.useremail,U.UserIM,U.Usersex from Ms_Friend F inner join [Ms_user] U on F.Friend=U.username where F.username='"&trim(membername)&"' and Myhack=1 order by F.addtime desc"
	elseif list=6 then
	sql="select F.*,U.useremail,U.UserIM,U.Usersex from Ms_Friend F inner join [Ms_user] U on F.username=U.username where F.Friend='"&trim(membername)&"' and Myhack=1 order by F.addtime desc"
	end if
	rs.open sql,conn,1,1
	if rs.eof and rs.bof then
%>
    <tr> 
      <td class=tablebody1 align=center valign=middle colspan=8>您的列表中没有任何内容。</td>
    </tr>
    <%else
	call rspages()
   do while not rs.eof and page_count<Cint(MaxPerPage)%>
    <tr> 
      <td align=center valign=middle class=tablebody1> <%if list=1 or list=2 or list=5 then
					response.Write("<a href=dispuser.asp?Username="&ihtmlencode(rs("friend"))&" target=_blank>"&ihtmlencode(rs("friend"))&"</a>")
					else
					response.Write("<a href=dispuser.asp?Username="&ihtmlencode(rs("Username"))&" target=_blank>"&ihtmlencode(rs("Username"))&"</a>")
					end if%></td>
      <td align=center valign=middle class=tablebody1> <%if ihtmlencode(rs("usersex"))=1 then
					response.Write("帅哥")
					else
					response.Write("靓女")
					end if%></td>
      <td align=center valign=middle class=tablebody1> <%if rs("Fsub")=1 then
					response.Write("审核")
					else
					response.Write("<font color=red>未审</font>")
					end if%></td>
      <td align=center valign=middle class=tablebody1><a href="mailto:<%=ihtmlencode(rs("useremail"))%>"><%=ihtmlencode(rs("useremail"))%></a></td>
      <td align=center class=tablebody1><a href="<%=ihtmlencode(split(rs("UserIM"),"|||")(0))%>" target=_blank><%=ihtmlencode(split(rs("UserIM"),"|||")(0))%></a></td>
      <td align=center class=tablebody1><%=ihtmlencode(split(rs("UserIM"),"|||")(1))%></td>
      <td align=center class=tablebody1><a href=JavaScript:openScript('messanger.asp?action=new&touser=<%=ihtmlencode(rs("friend"))%>',500,400)>发送</a></td>
      <td align=center class=tablebody1><input type=checkbox name=id value=<%=rs("fid")%>></td>
    </tr>
    <%page_count=page_count+1
	rs.movenext
	loop
	end if
%>
    <tr> 
      <td align=right valign=middle colspan=8 class=tablebody2><%if totalrec>0 then
		  	call showpage(strFileName)
		  end if%></td>
      <input type=hidden name=list value=<%=list%>>
    </tr>
    <tr>
      <td align=right valign=middle colspan=8 class=tablebody2><input type=checkbox name=chkall value=on onclick="CheckAll(this.form)">
        选中所有显示记录&nbsp;
        <input type=button name=action onclick="location.href='friendlist.asp?action=addF'" value="添加好友"> 
        <%if list=3 or list=4 then%>
        &nbsp;
        <input type=submit name=action onclick="{if(confirm('确定审核选定的纪录吗?')){this.document.inbox.submit();return true;}return false;}" value="审核"> 
        <%end if%>
        &nbsp; <input type=submit name=action onclick="{if(confirm('确定移动选定的纪录吗?')){this.document.inbox.submit();return true;}return false;}" value="移动" <%if list=3 or list=4 or list=6 then
		  response.Write("disabled")
		  end if%>>
        ->
        <select name="Listname" size="1">
          <option>请选择</option>
          <option value="1">好友名单</option>
          <option value="2">我追求的人</option>
          <option value="3">黑名单</option>
        </select>
        &nbsp;
        <input type=submit name=action onclick="{if(confirm('确定发送援救纪录吗?')){this.document.inbox.submit();return true;}return false;}" value="援救" <%if list<>6 then
		  response.Write("disabled")
		  end if%>>
        &nbsp;
        <input type=submit name=action onclick="{if(confirm('确定删除选定的纪录吗?')){this.document.inbox.submit();return true;}return false;}" value="删除" <%if list=3 or list=4 or list=6 then
		  response.Write("disabled")
		  end if%>>
        &nbsp;
        <input type=submit name=action onclick="{if(confirm('确定清除所有的纪录吗?')){this.document.inbox.submit();return true;}return false;}" value="清空好友" <%if list=3 or list=4 or list=6 then
		  response.Write("disabled")
		  end if%>></td>
    </tr>
  </form>
  <tr> 
    <td class=tablebody1 align=left valign=middle colspan=8><font color=red>注意：</font>
	<li>您最多可加好友：<font color="red"><%=GroupSetting(145)%></font> 人（包括好友、追求、黑名单等）</li> 
      　　<li> 建立好友金钱/篇 <b><%=GroupSetting(148)%> <%=GroupSetting(149)%></b> 元；</li>
		<li>建立好友魅力/篇 <b><%=GroupSetting(150)%> <%=GroupSetting(151)%></b> 点；</li>
		<li>建立好友经验/篇 <b><%=GroupSetting(152)%> <%=GroupSetting(153)%></b> 点；</li>
      　<li>如发现被列黑名单，发出援救信息，请求撤消！</li></td>
  </tr>
</table>
<%
	rs.close
	set rs=nothing
end sub

sub Frienpic()
response.write "<TABLE cellpadding=6 cellspacing=1 align=center class=tableborder1><TBODY>"&_
				"<TR>"&_
				"<TD align=center class=tablebody1><a href=friendlist.asp?list=1><img src=images/friend1.gif border=0 alt=我的好友></a> &nbsp; <a href=friendlist.asp?list=2><img src=images/friend2.gif border=0 alt=我追求的人></a>&nbsp; <a href=friendlist.asp?list=3><img src=images/friend3.gif border=0 alt=追我的人></a>&nbsp; <a href=friendlist.asp?list=4><img src=images/friend4.gif border=0 alt=把我加入好友></a>&nbsp;<a href=friendlist.asp?list=5><img src=images/friend5.gif border=0 alt=我的黑名单></a>&nbsp;<a href=friendlist.asp?list=6><img src=images/friend6.gif border=0 alt=我被列入黑名单></a>"&_
                           "</td></tr></TBODY></TABLE>"
end sub

'下面是删除操作
sub delFriend()
dim delid,fixid,CountID,CountIDs
list=request.form("list")
if list=1 or list=2 or list=5 then
delid=replace(request.form("id"),"'","")
delid=replace(delid,";","")
delid=replace(delid,"--","")
delid=replace(delid,")","")
fixid=replace(delid,",","")
fixid=Trim(replace(fixid," ",""))
If Not IsNumeric(fixid) Then
	Errmsg=Errmsg+"<br><li>错误的系统参数。"
	founderr=true
	exit sub
End If
if delid="" or isnull(delid) then
Errmsg=Errmsg+"<li>"+"请选择相关参数。"
founderr=true
exit sub
else
CountID=split(delid,",")
CountIDs=ubound(CountID)
if CountIDs>0 then
CountIDs=CountIDs+1
else
CountIDs=0
end if
conn.execute("update Ms_User set Friendjoin=Friendjoin-"&CountIDs&" where Username='"&trim(membername)&"'")
	conn.execute("delete from Ms_friend where username='"&trim(membername)&"' and Fid in ("&delid&")")
	sucmsg=sucmsg+"<br>"+"<li><b>您已经删除选定的好友记录。"
	call Mslove_suc()
end if
else
errmsg=errmsg+"<br>"+"<li>您没有权限删除。"
founderr=true
	call Mslove_error()
	exit sub
end if
end sub
'下面是清空操作
sub AllDelFriend()
dim CountID
list=request.form("list")
if list=1 or list=2 or list=5 then
sql="select count(Fid) from [Ms_friend] where Username='"&trim(membername)&"'"
set rs=conn.execute(sql)
if not (rs.eof and rs.bof) then
CountID=rs(0)
else
CountID=0
end if
rs.close
conn.execute("update Ms_User set Friendjoin=Friendjoin-"&CountID&" where Username='"&trim(membername)&"'")
	conn.execute("delete from Ms_friend where username='"&trim(membername)&"'")
	sucmsg=sucmsg+"<br>"+"<li><b>您已经删除了所有好友列表。"
	call Mslove_suc()
else
errmsg=errmsg+"<br>"+"<li>您没有权限删除。"
founderr=true
	call Mslove_error()
	exit sub
end if	
end sub
'下面是审核操作
sub Allsavectrl()
if Cint(GroupSetting(155))=0 then
errmsg=errmsg+"<br>"+"<li>您没有审核权限，请升级等级，再来操作。"
founderr=true
	call Mslove_error()
	exit sub
end if
dim delid,fixid
list=request.form("list")
if list=3 or list=4 then
delid=replace(request.form("id"),"'","")
delid=replace(delid,";","")
delid=replace(delid,"--","")
delid=replace(delid,")","")
fixid=replace(delid,",","")
fixid=Trim(replace(fixid," ",""))
If Not IsNumeric(fixid) Then
	Errmsg=Errmsg+"<br><li>错误的系统参数。"
	founderr=true
	exit sub
End If
if Chkvalue(1,GroupSetting(148),Cint(GroupSetting(149)))=false then
	errmsg=errmsg+"<br>"+"<li>对不起，您的金币不够请确认。"
	founderr=true
end if
if Chkvalue(2,GroupSetting(150),Cint(GroupSetting(151)))=false then
	errmsg=errmsg+"<br>"+"<li>对不起，您的魅力值不够请确认。"
	founderr=true
end if
if Chkvalue(3,GroupSetting(152),Cint(GroupSetting(153)))=false then
	errmsg=errmsg+"<br>"+"<li>对不起，您的经验值不够请确认。"
	founderr=true
end if
if delid="" or isnull(delid) then
Errmsg=Errmsg+"<li>"+"请选择相关参数。"
founderr=true
exit sub
else
set rs=server.createobject("adodb.recordset")
sql="select username from [Ms_friend] where Fid in ("&delid&")"
set rs=conn.execute(sql)
if not (rs.eof and rs.bof) then
do while not rs.eof
conn.execute("update Ms_user set UserWealth=UserWealth "&GroupSetting(148)&Cint(GroupSetting(149))&",UserEP=UserEP "&GroupSetting(150)&Cint(GroupSetting(151))&",UserCP=UserCP "&GroupSetting(152)&Cint(GroupSetting(153))&" where Username='"&rs("Username")&"'")
rs.movenext
loop
end if
rs.close
	conn.execute("Update Ms_friend set Fsub=1 where Fid in ("&delid&")")
	sucmsg=sucmsg+"<br>"+"<li><b>您已经审核选定的好友记录。"
	sucmsg=sucmsg+"<br>"+"<li><b>您已经成功更新对方的金元及魅力值。"
	call Mslove_suc()
end if
else
errmsg=errmsg+"<br>"+"<li>您没有权限审核。"
founderr=true
	call Mslove_error()
	exit sub
end if
end sub
'下面是移动操作
sub MoveAllto()
if Cint(GroupSetting(144))=0 then
  	errmsg=errmsg+"<br>"+"<li>您没有添加好友的权限，请等级升级之后，再来操作。"
	founderr=true
	exit sub
end if
dim delid,fixid,upctrl
list=request.form("list")
listname=request.form("listname")
if list=1 or list=2 or list=5 then
delid=replace(request.form("id"),"'","")
delid=replace(delid,";","")
delid=replace(delid,"--","")
delid=replace(delid,")","")
fixid=replace(delid,",","")
fixid=Trim(replace(fixid," ",""))
If Not IsNumeric(fixid) Then
	Errmsg=Errmsg+"<br><li>错误的系统参数。"
	founderr=true
	exit sub
End If
if Not IsNumeric(listname) or listname="" then
	Errmsg=Errmsg+"<br><li>请选择移动到什么列表。"
	founderr=true
	exit sub
End If
if delid="" or isnull(delid) then
Errmsg=Errmsg+"<li>"+"请选择相关参数。"
founderr=true
exit sub
else
if listname=1 then
upctrl="Mybest=1,Mylove=0,Myhack=0"
elseif listname=2 then
upctrl="Mylove=1,Mybest=0,Myhack=0"
else
upctrl="Myhack=1,Mylove=0,Mybest=0"
end if
	conn.execute("update Ms_friend set "&upctrl&" where username='"&trim(membername)&"' and Fid in ("&delid&")")
	sucmsg=sucmsg+"<br>"+"<li><b>您已经成功移动选定的记录。"
	call Mslove_suc()
end if
else
errmsg=errmsg+"<br>"+"<li>您没有权限移动。"
founderr=true
	call Mslove_error()
	exit sub
end if
end sub

sub Sendsos()
if Cint(GroupSetting(156))=0 then
errmsg=errmsg+"<br>"+"<li>您没有发送求救信息的权限，请升级等级，再来操作。"
founderr=true
	call Mslove_error()
	exit sub
end if
dim delid,fixid
list=request.form("list")
if list=6 then
delid=replace(request.form("id"),"'","")
delid=replace(delid,";","")
delid=replace(delid,"--","")
delid=replace(delid,")","")
fixid=replace(delid,",","")
fixid=Trim(replace(fixid," ",""))
If Not IsNumeric(fixid) Then
	Errmsg=Errmsg+"<br><li>没有选择相应记录或者参数错误。"
	founderr=true
	exit sub
End If
if delid="" or isnull(delid) then
Errmsg=Errmsg+"<li>"+"请选择相关参数。"
founderr=true
exit sub
end if
if founderr then call Mslove_error()
%>
<form action="Friendlist.asp" method=post name=messager>
<table cellpadding=3 cellspacing=1 align=center class=tableborder1>
          <tr> 
            <th colspan=2> 
              <input type=hidden name="action" value="Sendsosto">
			  <input type=hidden name="delid" value=<%=delid%>>
              发出求救信息</th>
          </tr>
          <tr> 
            <td class=tablebody1 valign=middle width=70><b>标题：</b></td>
            <td class=tablebody1 valign=middle>
              <input type=text name="title" size=40>
			  &nbsp;请醒目输入求救信息
            </td>
          </tr>
		  <tr> 
            <td class=tablebody1 valign=middle width=70><b>内容：</b></td>
            <td class=tablebody1 valign=middle>
              <textarea name="content" cols="60" rows="5"></textarea>
			  &nbsp;<br>最多100个字，内容最好提及您的大名
            </td>
          </tr>
          <tr> 
            <td valign=middle colspan=2 align=center class=tablebody2> 
              <input class=2 type=Submit value="保存" name=Submit>
              &nbsp; 
              <input class=2 type="reset" name="Clear" value="清除">
            </td>
          </tr>
        </table>
      </td>
    </tr>
  </table>
</form>
<%end if
end sub

'下面是援救操作
sub Sendsosto()
dim delid,fixid,Title,content,incept,Username
list=request.form("list")
delid=replace(request.form("delid"),"'","")
delid=replace(delid,";","")
delid=replace(delid,"--","")
delid=replace(delid,")","")
fixid=replace(delid,",","")
fixid=Trim(replace(fixid," ",""))
If Not IsNumeric(fixid) Then
	Errmsg=Errmsg+"<br><li>错误的系统参数。"
	founderr=true
	exit sub
End If
if request("title")="" then
	errmsg=errmsg+"<br>"+"<li>您还没有填写标题呀。"
	founderr=true
	exit sub
elseif strlength(request("title"))>50 then
	errmsg=errmsg+"<br>"+"<li>标题限定最多50个字符。"
	founderr=true
	exit sub
else
	title=CheckStr(request("title"))
end if
if request("Content")="" then
	errmsg=errmsg+"<br>"+"<li>您还没有填写内容呀。"
	founderr=true
	exit sub
elseif strlength(request("Content"))>100 then
	errmsg=errmsg+"<br>"+"<li>内容限定最多100个字符。"
	founderr=true
	exit sub
else
	Content=CheckStr(request("Content"))
end if
if delid="" or isnull(delid) then
Errmsg=Errmsg+"<li>"+"请选择相关参数。"
founderr=true
exit sub
else
set rs=server.createobject("adodb.recordset")
sql="select username from [Ms_friend] where Fid in ("&delid&")"
set rs=conn.execute(sql)
if not (rs.eof and rs.bof) then
do while not rs.eof
username=username&rs("username")&","
rs.movenext
loop
end if
rs.close
incept=split(username,",")
for i=0 to ubound(incept)
if incept(i)<>"" then
sql="insert into Ms_message (incept,sender,title,content,sendtime,flag,issend) values ('"&incept(i)&"','"&title&"','"&title&"','"&Content&"',getdate(),0,1)"
conn.execute(sql)
end if
next
end if
	sucmsg=sucmsg+"<br>"+"<li><b>您已经成功发送求救信号。"
	call Mslove_suc()
end sub

sub addF()
if Cint(GroupSetting(144))=0 then
  	errmsg=errmsg+"<br>"+"<li>您没有添加好友的权限，请等级升级之后，再来操作。"
	founderr=true
	exit sub
end if
if Cint(GroupSetting(147))<>0 and dateadd("n",Cint(GroupSetting(147)),myjoinDate)>=Now() then
  	errmsg=errmsg+"<br>"+"<li>新注册用户"&Cint(GroupSetting(147))&"分钟后才能添加好友，请稍后再<a href=login.asp target=_blank>登录</a>。"
	founderr=true
	exit sub
end if
%>
<br>
<table cellpadding=3 cellspacing=1 align=center class=tableborder1>
  <form action="Friendlist.asp" method=post name=messager>
    <tr> 
      <th colspan=2> <input type=hidden name="action" value="saveF">
        加入好友--请完整输入下列信息</th>
    </tr>
    <tr> 
      <td width=90 valign=middle class=tablebody1><b>好　　友：</b></td>
      <td width="590" valign=middle class=tablebody1> <input type=text name="touser" size=50 value="<%=request("myFriend")%>"> 
        &nbsp;使用逗号（,）分开，最多5位用户 </td>
    </tr>
		    <%if Cint(Codeshow(10))=1 then%>
    <tr> 
      <td height="27" class=tablebody1><b>检验码：</b></td>
      <td align="left"  class=tablebody1> <input type="text" name="codestr" maxlength="4" size="4"> 
        &nbsp;<%=GetCode()%>&nbsp;</td>
    </tr>
    <%end if%>
    <tr> 
      <td width=90 valign=middle class=tablebody1><strong>提示方式：</strong></td>
      <td class=tablebody1 valign=middle><input name="sends" type="radio" value="1">
        系统自带短信 
        <input name="sends" type="radio" value="0" checked>
        用户自己输入</td>
    </tr>
    <tr> 
      <td width=90 valign=middle class=tablebody1><strong>标　　题：</strong></td>
      <td class=tablebody1 valign=middle><input name="Title" type="text" id="Title" size="50"> 
        &nbsp;请醒目交友信息</td>
    </tr>
    <tr> 
      <td width=90 valign=middle class=tablebody1><strong>短　　信：</strong></td>
      <td class=tablebody1 valign=middle><textarea name="Content" cols="60" rows="6" id="Content"></textarea> 
        <br>
        最多100个字</td>
    </tr>
    <tr> 
      <td valign=middle colspan=2 align=center class=tablebody2> <input class=2 type=Submit value="保存" name=Submit> 
        &nbsp; <input class=2 type="reset" name="Clear" value="清除"> </td>
    </tr>
    <tr>
      <td valign=middle colspan=2 class=tablebody1><font color="#FF0000">注意：</font><br>
        　　<li>您最多可加好友：<font color="red"><%=GroupSetting(145)%></font> 人（包括好友、追求、黑名单等）</li> 
      　　<li> 建立好友金钱/篇 <b><%=GroupSetting(148)%> <%=GroupSetting(149)%></b> 元；</li>
		<li>建立好友魅力/篇 <b><%=GroupSetting(150)%> <%=GroupSetting(151)%></b> 点；</li>
		<li>建立好友经验/篇 <b><%=GroupSetting(152)%> <%=GroupSetting(153)%></b> 点；</li>
      　<li>如发现被列黑名单，发出援救信息，请求撤消！</li>
      </td>
    </tr>
  </form>
</table>
<%
end sub

sub saveF()
if Not ChkPost then'查检提交数据
	ErrMsg=ErrMsg+"<Br>"+"<li>您提交的数据不合法，请不要从外部提交发言。"
   	FoundErr=True
end if

if Cint(Codeshow(10))=1 then
	if Not CodeIsTrue() then
		errmsg=errmsg+"<br>"+"<li>验证码校验失败，请返回刷新页面后再输入验证码。"
		founderr=true
	end if
end if
if Cint(GroupSetting(144))=0 then
  	errmsg=errmsg+"<br>"+"<li>您没有添加好友的权限，请等级升级之后，再来操作。"
	founderr=true
	exit sub
end if
dim incept,Countfriend,sends,Title,Content,checkVip
if request("touser")="" then
	errmsg=errmsg+"<br>"+"<li>您忘记填写发送对象了吧。"
	founderr=true
	exit sub
else
	incept=checkStr(request("touser"))
	incept=split(incept,",")
end if
sends=checkStr(request("sends"))
Title=checkStr(request("Title"))
Content=checkStr(request("Content"))
if sends=0 then
if title="" or strlength(request("Title"))>50 then
	errmsg=errmsg+"<br>"+"<li>标题限定最多50个字符。"
	founderr=true
	exit sub
end if
if Content="" or strlength(request("Content"))>100 then
	errmsg=errmsg+"<br>"+"<li>内容限定最多100个字符。"
	founderr=true
	exit sub
end if
end if
if Cint(GroupSetting(147))<>0 and dateadd("n",Cint(GroupSetting(147)),myjoinDate)>=Now() then
  	errmsg=errmsg+"<br>"+"<li>新注册用户"&Cint(GroupSetting(147))&"分钟后才能添加好友，请稍后再<a href=login.asp target=_blank>登录</a>。"
	founderr=true
	exit sub
end if
for i=0 to ubound(incept)
set rs=server.createobject("adodb.recordset")
sql="select UserVip from [Ms_user] where username='"&incept(i)&"'"
set rs=conn.execute(sql)
if rs.eof and rs.bof then
	errmsg=errmsg+"<br>"+"<li>交友系统没有这个用户，操作未成功。"
	founderr=true
	exit sub
else
checkVip=rs("UserVip")
end if
set rs=nothing
set rs=server.createobject("adodb.recordset")'检查用户收友数量
sql="select Count(FID) from [Ms_friend] where username='"&trim(membername)&"'"
set rs=conn.execute(sql)
if not(rs.eof and rs.bof) then
Countfriend=rs(0)
else
Countfriend=0
end if
set rs=nothing
if Countfriend>=Cint(GroupSetting(145)) then
  	errmsg=errmsg+"<br>"+"<li>您的好友列表只能容纳"&Cint(GroupSetting(145))&"人，等级升级之后再添加。"
	founderr=true
	exit sub
end if
if membername=trim(incept(i)) then
	errmsg=errmsg+"<br>"+"<li>不能把自已添加为好友。"
	founderr=true
	exit sub
end if

sql="select friend from Ms_friend where username='"&trim(membername)&"' and friend='"&incept(i)&"'"
set rs=conn.execute(sql)
if rs.eof and rs.bof then
	sql="insert into Ms_friend (username,MyBest,friend,addtime) values ('"&trim(membername)&"',1,'"&trim(incept(i))&"',getdate())"
	conn.execute(sql)
		if incept(i)<>"" then
			if sends=1 then
			sql="insert into Ms_message (incept,sender,title,content,sendtime,flag,issend) values ('"&incept(i)&"','"&trim(membername)&"','恭喜您，您被加入好友名单','恭喜您，您被["&trim(membername)&"]加入好友名单',getdate(),0,1)"
			conn.execute(sql)
			else
			sql="insert into Ms_message (incept,sender,title,content,sendtime,flag,issend) values ('"&incept(i)&"','"&trim(membername)&"','"&Title&"','"&Content&"',getdate(),0,1)"
			conn.execute(sql)
			end if
		end if
else
	errmsg=errmsg+"<br>"+"<li>对不起，好友已经存在，请不要重复加入。"
	founderr=true
	exit sub
end if
if i>4 then
	errmsg=errmsg+"<br>"+"<li>每次最多只能添加5位用户，您的名单5位以后的请重新填写。"
	founderr=true
	exit sub
	exit for
end if
conn.execute("update Ms_user set Friendjoin=Friendjoin+1 where Username='"&trim(membername)&"'")
next
sucmsg=sucmsg+"<br>"+"<li><b>恭喜您，好友添加成功。"
call Mslove_suc()
end sub
%>